home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The X-Philes (2nd Revision)
/
The X-Philes Number 1 (1995).iso
/
xphiles
/
hp48hor1
/
symbmat2.src
< prev
next >
Wrap
Text File
|
1991-10-19
|
5KB
|
315 lines
%%HP: T(3)A(R)F(.);
@ SYMBMAT2 by Marc E Blair
DIR
\->q
\<<
IF QR
THEN '\->q\[]'
DUP RCL SWAP PURGE
'\->q' STO
ELSE '\->q' DUP
RCL SWAP PURGE
'\->q\[]' STO
END QR NOT
'QR' STO
\>>
Rr
\<< Dec \-> L S
\<< S L \161RR 0 1
S
FOR A A L *
A - 2 + PICK +
NEXT
IF ZRO?
SWAP DROP NOT
THEN S L
\161RR
END 1 L
FOR A S
\->LIST L A - S * A +
ROLLD
NEXT L
\->LIST
\>>
\>>
det
\<< Dec DROP MNN
\>>
EC
\<< EVAL
DO DUP EXPAN
DUP ROT
UNTIL SIZE
SWAP SIZE ==
END
DO DUP COLCT
DUP ROT
UNTIL SIZE
SWAP SIZE ==
END
\>>
SIMEQ
\<< DUP Dec DUP
IF 6 <
THEN DUP2 1 -
IF ==
THEN DROP \->
Ss
\<< 0 Ss
FOR Aa
Ss DUP * Ss
FOR
Bb Bb Aa + PICK Ss
NEG
STEP
Ss \->LIST Ss Ss 1 +
* 1 + ROLLD
NEXT Ss
Ss 1 + * DROPN Ss 1
+ ROLL \-> Cc
\<< Ss
DUPN Ss \->LIST det \->
Dd
\<<
IF Dd ZRO? SWAP
DROP NOT
THEN 1 Ss
FOR Aa Ss DUPN Aa
ROLL DROP Cc Aa
ROLLD Ss \->LIST det
Dd /
IF QR
THEN \->Q
END Ss 1 +
ROLLD
NEXT Ss DROPN Ss
\->LIST
ELSE Ss DROPN
"No Solution"
END
\>>
\>>
\>>
ELSE *
DROPN
"BAD # OF EQS"
END SWAP
DROP
ELSE * DROPN
SM2
END
\>>
inv
\<< Dec \-> S L
\<< 0 L 1 -
FOR A 0 S 1
-
FOR B A B
== L S * L - 1 + A
L * - ROLLD
NEXT
NEXT L S
\>> DUP + \-> L S
\<< S L \161RR 1 L
FOR A S 2 /
\->LIST L A - S * A +
S 2 / + ROLLD S 2 /
DROPN
NEXT L
\->LIST
\>>
\>>
MEC
\<< OBJ\-> \-> A
\<< 1 A 1 -
FOR B +
NEXT OBJ\-> \->
S
\<< 1 S
FOR C EC
S ROLLD
NEXT 1 A
FOR D S A
/ \->LIST S S A / D *
- D + ROLLD
NEXT A
\->LIST
\>>
\>>
\>>
SM2
\<< Rr 0 'ER' STO
{ } SWAP OBJ\-> \-> S
\<< 1 S
FOR A OBJ\->
\-> L
\<< L S A -
- ROLL
IF 1 \=/
THEN 1
'ER' STO
END S A
- L + ROLL + S A -
L 1 - + ROLLD 0 1 L
2 -
FOR C +
NEXT
IF 0 \=/
THEN 1
'ER' STO
END
\>>
NEXT
IF ER 1 ==
THEN DROP
"NO SOLUTION"
END 'ER'
PURGE
\>>
\>>
Dec
\<< OBJ\-> DUP TYPE
IF 5 ==
THEN EVAL
ELSE \-> L
\<< 1 L 1 -
FOR A +
NEXT OBJ\->
L / L SWAP
\>>
END
\>>
ZRO?
\<< DUP TYPE 0
IF \=/
THEN 0
ELSE DUP
IF 0 \=/
THEN 0
ELSE 1
END
END
\>>
\161RR
\<< \-> L S
\<< 0 S 1 -
FOR A S L *
A - DUP 1 + PICK \->
F M1
\<< 1 S 1 -
FOR B F
B L * - DUP 1 +
PICK \-> C M2
\<< M2
ZRO?
IF NOT
THEN DROP 0 L 1 -
FOR D C A + D -
ROLL M1 0 'DOIT'
STO ZRO?
IF NOT
THEN *
ELSE DROP 1
'DOIT' STO
END F A + D -
PICK M2 ZRO?
IF NOT
THEN *
ELSE DROP 1
'DOIT' STO
END - EXPAN
COLCT C A + D -
ROLLD
NEXT
ELSE DROP
END
\>>
NEXT 1
L
FOR Q S
L * ROLL
NEXT
\>> 'DOIT'
PURGE
NEXT 0 S 1
-
FOR B L S B
- * B - PICK S B -
L * \-> D F
\<< 0 L 1 -
FOR C F
C - ROLL
IF D
TYPE 0 ==
THEN
IF D 0 ==
THEN \oo *
ELSE D / COLCT
IF QR
THEN \->Q
END DUP TYPE 9 ==
OVER EVAL DUP IP ==
AND
IF DUP TYPE 0 ==
THEN
IF
THEN EVAL
END
ELSE DROP
END
END
ELSE
D / COLCT
END F
C - ROLLD
NEXT
\>>
NEXT
\>>
\>>
MNN
\<< \-> Ss
\<<
IF Ss 3 ==
THEN 6 DUPN
6 DUPN ROT DROP 4
ROLL * 3 ROLLD * -
SWAP DROP 16 PICK *
16 ROLLD SWAP DROP
4 ROLL DROP 4 ROLL
* 3 ROLLD * - 9
PICK * 10 ROLLD
DROP ROT DROP 4
ROLL * 3 ROLLD * -
* ROT DROP SWAP
DROP SWAP - +
ELSE
IF Ss 2
==
THEN 4
ROLL * 3 ROLLD * -
ELSE 1 Ss
FOR Aa
Ss DUP DUP * SWAP -
DUPN Ss DUP * Ss 2
* - 0
FOR
Bb Bb Aa + ROLL
DROP Ss NEG
STEP
Ss 1 - MNN Ss DUP *
Ss - Aa + 1 + PICK
* -1 Aa Ss + ^ * Ss
Ss * 1 + ROLLD
NEXT Ss
Ss * DROPN 1 Ss 1 -
FOR Aa
+
NEXT
END
END
\>>
\>>
QR 0
END